home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
mcedit10.zip
/
MCEDEMO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1991-12-01
|
41KB
|
1,407 lines
program mcedemo; { A demo program showing some of the things you can
do with a mouse. }
uses crt, graph, dos, bobmouse;
const
title = 'MOUSE CURSOR EDITOR DEMO - Written by Bob Hayes, December 1, 1991';
var
sysgraphadapter, sysgraphmode : integer;
graphdriver, graphmode : integer;
quit,right,both,left : boolean;
SIZE,pointerX, pointerY : word;
x,y,P,D, c2,i,x1,y1,x2,y2 : integer;
ch : char;
POINT : POINTER;
exitsave, bobsignp : pointer;
black, white, ltgray, dkgray, ltgreen : integer;
mx,my : word;
lb,rb,bb : boolean;
continue : boolean;
{--------------------------------------------------------------------------}
{ This is the programs exit procedure. It is called when the program
terminates, normally or because or a runtime error. In this case
it insures the the user is not left in a graphics screen or with the
mouse. }
{$F+}
procedure mcedemoexit;
begin
exitproc := exitsave;
hidemouse;
closegraph;
textbackground(0);
textcolor(7);
writeln('The End.');
writeln;
end;
{$F-}
{--------------------------------------------------------------------------}
{ Include the various cursor files. }
{$I default.pas}
{$I black.pas}
{$I hand.pas}
{$I handscan.pas}
{$I horsize.pas}
{$I vertsize.pas}
{$I textt.pas}
{$I magglass.pas}
{$I hourglas.pas}
{$I inverse.pas}
{$I seethrgh.pas}
{--------------------------------------------------------------------------}
{ Link signature image. }
{$L bobsign.obj}
procedure bobsign; external;
{ bobsign.obj contains a bitmap of my signiture in the form that TP can
place using the PutImage procedure. If you are interested in linking
bitmaps into your programs, drop my a line, I have written a utility
that converts PCX files into this Borland image format.}
{--------------------------------------------------------------------------}
PROCEDURE Mouse1;
{ Mouse1 to Mouse12 contain procedures, output by MCEDIT, for the cursor
animation demo. }
var
mm1masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
mm1masks[0,0] := $F81F; {1111100000011111}
mm1masks[0,1] := $E007; {1110000000000111}
mm1masks[0,2] := $C003; {1100000000000011}
mm1masks[0,3] := $8001; {1000000000000001}
mm1masks[0,4] := $0000; {0000000000000000}
mm1masks[0,5] := $0000; {0000000000000000}
mm1masks[0,6] := $0000; {0000000000000000}
mm1masks[0,7] := $0000; {0000000000000000}
mm1masks[0,8] := $0000; {0000000000000000}
mm1masks[0,9] := $8001; {1000000000000001}
mm1masks[0,10] := $C003; {1100000000000011}
mm1masks[0,11] := $E007; {1110000000000111}
mm1masks[0,12] := $F81F; {1111100000011111}
mm1masks[0,13] := $FFFF; {1111111111111111}
mm1masks[0,14] := $FFFF; {1111111111111111}
mm1masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
mm1masks[1,0] := $0000; {0000000000000000}
mm1masks[1,1] := $07E0; {0000011111100000}
mm1masks[1,2] := $1FE8; {0001111111101000}
mm1masks[1,3] := $3FDC; {0011111111011100}
mm1masks[1,4] := $7E5E; {0111111001011110}
mm1masks[1,5] := $7E3E; {0111111000111110}
mm1masks[1,6] := $7E3E; {0111111000111110}
mm1masks[1,7] := $7E7E; {0111111001111110}
mm1masks[1,8] := $7FFE; {0111111111111110}
mm1masks[1,9] := $3FFC; {0011111111111100}
mm1masks[1,10] := $1FF8; {0001111111111000}
mm1masks[1,11] := $07E0; {0000011111100000}
mm1masks[1,12] := $0000; {0000000000000000}
mm1masks[1,13] := $0000; {0000000000000000}
mm1masks[1,14] := $0000; {0000000000000000}
mm1masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(mm1masks);
regs.ES := seg(mm1masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse2;
var
m2masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m2masks[0,0] := $F81F; {1111100000011111}
m2masks[0,1] := $E007; {1110000000000111}
m2masks[0,2] := $C003; {1100000000000011}
m2masks[0,3] := $8001; {1000000000000001}
m2masks[0,4] := $0000; {0000000000000000}
m2masks[0,5] := $0000; {0000000000000000}
m2masks[0,6] := $0000; {0000000000000000}
m2masks[0,7] := $0000; {0000000000000000}
m2masks[0,8] := $0000; {0000000000000000}
m2masks[0,9] := $8001; {1000000000000001}
m2masks[0,10] := $C003; {1100000000000011}
m2masks[0,11] := $E007; {1110000000000111}
m2masks[0,12] := $F81F; {1111100000011111}
m2masks[0,13] := $FFFF; {1111111111111111}
m2masks[0,14] := $FFFF; {1111111111111111}
m2masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m2masks[1,0] := $0000; {0000000000000000}
m2masks[1,1] := $07E0; {0000011111100000}
m2masks[1,2] := $1FF8; {0001111111111000}
m2masks[1,3] := $3FFC; {0011111111111100}
m2masks[1,4] := $7E72; {0111111001110010}
m2masks[1,5] := $7E4E; {0111111001001110}
m2masks[1,6] := $7E3E; {0111111000111110}
m2masks[1,7] := $7E7E; {0111111001111110}
m2masks[1,8] := $7FFE; {0111111111111110}
m2masks[1,9] := $3FFC; {0011111111111100}
m2masks[1,10] := $1FF8; {0001111111111000}
m2masks[1,11] := $07E0; {0000011111100000}
m2masks[1,12] := $0000; {0000000000000000}
m2masks[1,13] := $0000; {0000000000000000}
m2masks[1,14] := $0000; {0000000000000000}
m2masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m2masks);
regs.ES := seg(m2masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse3;
var
m3masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m3masks[0,0] := $F81F; {1111100000011111}
m3masks[0,1] := $E007; {1110000000000111}
m3masks[0,2] := $C003; {1100000000000011}
m3masks[0,3] := $8001; {1000000000000001}
m3masks[0,4] := $0000; {0000000000000000}
m3masks[0,5] := $0000; {0000000000000000}
m3masks[0,6] := $0000; {0000000000000000}
m3masks[0,7] := $0000; {0000000000000000}
m3masks[0,8] := $0000; {0000000000000000}
m3masks[0,9] := $8001; {1000000000000001}
m3masks[0,10] := $C003; {1100000000000011}
m3masks[0,11] := $E007; {1110000000000111}
m3masks[0,12] := $F81F; {1111100000011111}
m3masks[0,13] := $FFFF; {1111111111111111}
m3masks[0,14] := $FFFF; {1111111111111111}
m3masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m3masks[1,0] := $0000; {0000000000000000}
m3masks[1,1] := $07E0; {0000011111100000}
m3masks[1,2] := $1FF8; {0001111111111000}
m3masks[1,3] := $3FFC; {0011111111111100}
m3masks[1,4] := $7E7E; {0111111001111110}
m3masks[1,5] := $7E7E; {0111111001111110}
m3masks[1,6] := $7E00; {0111111000000000}
m3masks[1,7] := $7E7E; {0111111001111110}
m3masks[1,8] := $7FFE; {0111111111111110}
m3masks[1,9] := $3FFC; {0011111111111100}
m3masks[1,10] := $1FF8; {0001111111111000}
m3masks[1,11] := $07E0; {0000011111100000}
m3masks[1,12] := $0000; {0000000000000000}
m3masks[1,13] := $0000; {0000000000000000}
m3masks[1,14] := $0000; {0000000000000000}
m3masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m3masks);
regs.ES := seg(m3masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse4;
var
m4masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m4masks[0,0] := $F81F; {1111100000011111}
m4masks[0,1] := $E007; {1110000000000111}
m4masks[0,2] := $C003; {1100000000000011}
m4masks[0,3] := $8001; {1000000000000001}
m4masks[0,4] := $0000; {0000000000000000}
m4masks[0,5] := $0000; {0000000000000000}
m4masks[0,6] := $0000; {0000000000000000}
m4masks[0,7] := $0000; {0000000000000000}
m4masks[0,8] := $0000; {0000000000000000}
m4masks[0,9] := $8001; {1000000000000001}
m4masks[0,10] := $C003; {1100000000000011}
m4masks[0,11] := $E007; {1110000000000111}
m4masks[0,12] := $F81F; {1111100000011111}
m4masks[0,13] := $FFFF; {1111111111111111}
m4masks[0,14] := $FFFF; {1111111111111111}
m4masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m4masks[1,0] := $0000; {0000000000000000}
m4masks[1,1] := $07E0; {0000011111100000}
m4masks[1,2] := $1FF8; {0001111111111000}
m4masks[1,3] := $3FFC; {0011111111111100}
m4masks[1,4] := $7E7E; {0111111001111110}
m4masks[1,5] := $7E7E; {0111111001111110}
m4masks[1,6] := $7E7E; {0111111001111110}
m4masks[1,7] := $7E1E; {0111111000011110}
m4masks[1,8] := $7FE6; {0111111111100110}
m4masks[1,9] := $3FF8; {0011111111111000}
m4masks[1,10] := $1FF8; {0001111111111000}
m4masks[1,11] := $07E0; {0000011111100000}
m4masks[1,12] := $0000; {0000000000000000}
m4masks[1,13] := $0000; {0000000000000000}
m4masks[1,14] := $0000; {0000000000000000}
m4masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m4masks);
regs.ES := seg(m4masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse5;
var
m5masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m5masks[0,0] := $F81F; {1111100000011111}
m5masks[0,1] := $E007; {1110000000000111}
m5masks[0,2] := $C003; {1100000000000011}
m5masks[0,3] := $8001; {1000000000000001}
m5masks[0,4] := $0000; {0000000000000000}
m5masks[0,5] := $0000; {0000000000000000}
m5masks[0,6] := $0000; {0000000000000000}
m5masks[0,7] := $0000; {0000000000000000}
m5masks[0,8] := $0000; {0000000000000000}
m5masks[0,9] := $8001; {1000000000000001}
m5masks[0,10] := $C003; {1100000000000011}
m5masks[0,11] := $E007; {1110000000000111}
m5masks[0,12] := $F81F; {1111100000011111}
m5masks[0,13] := $FFFF; {1111111111111111}
m5masks[0,14] := $FFFF; {1111111111111111}
m5masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m5masks[1,0] := $0000; {0000000000000000}
m5masks[1,1] := $07E0; {0000011111100000}
m5masks[1,2] := $1FF8; {0001111111111000}
m5masks[1,3] := $3FFC; {0011111111111100}
m5masks[1,4] := $7E7E; {0111111001111110}
m5masks[1,5] := $7E7E; {0111111001111110}
m5masks[1,6] := $7E7E; {0111111001111110}
m5masks[1,7] := $7E7E; {0111111001111110}
m5masks[1,8] := $7FBE; {0111111110111110}
m5masks[1,9] := $3FDC; {0011111111011100}
m5masks[1,10] := $1FD8; {0001111111011000}
m5masks[1,11] := $07E0; {0000011111100000}
m5masks[1,12] := $0000; {0000000000000000}
m5masks[1,13] := $0000; {0000000000000000}
m5masks[1,14] := $0000; {0000000000000000}
m5masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m5masks);
regs.ES := seg(m5masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse6;
var
m6masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m6masks[0,0] := $F81F; {1111100000011111}
m6masks[0,1] := $E007; {1110000000000111}
m6masks[0,2] := $C003; {1100000000000011}
m6masks[0,3] := $8001; {1000000000000001}
m6masks[0,4] := $0000; {0000000000000000}
m6masks[0,5] := $0000; {0000000000000000}
m6masks[0,6] := $0000; {0000000000000000}
m6masks[0,7] := $0000; {0000000000000000}
m6masks[0,8] := $0000; {0000000000000000}
m6masks[0,9] := $8001; {1000000000000001}
m6masks[0,10] := $C003; {1100000000000011}
m6masks[0,11] := $E007; {1110000000000111}
m6masks[0,12] := $F81F; {1111100000011111}
m6masks[0,13] := $FFFF; {1111111111111111}
m6masks[0,14] := $FFFF; {1111111111111111}
m6masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m6masks[1,0] := $0000; {0000000000000000}
m6masks[1,1] := $07E0; {0000011111100000}
m6masks[1,2] := $1FF8; {0001111111111000}
m6masks[1,3] := $3FFC; {0011111111111100}
m6masks[1,4] := $7E7E; {0111111001111110}
m6masks[1,5] := $7E7E; {0111111001111110}
m6masks[1,6] := $7E7E; {0111111001111110}
m6masks[1,7] := $7E7E; {0111111001111110}
m6masks[1,8] := $7EFE; {0111111011111110}
m6masks[1,9] := $3EFC; {0011111011111100}
m6masks[1,10] := $1EF8; {0001111011111000}
m6masks[1,11] := $06E0; {0000011011100000}
m6masks[1,12] := $0000; {0000000000000000}
m6masks[1,13] := $0000; {0000000000000000}
m6masks[1,14] := $0000; {0000000000000000}
m6masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m6masks);
regs.ES := seg(m6masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse7;
var
m7masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m7masks[0,0] := $F81F; {1111100000011111}
m7masks[0,1] := $E007; {1110000000000111}
m7masks[0,2] := $C003; {1100000000000011}
m7masks[0,3] := $8001; {1000000000000001}
m7masks[0,4] := $0000; {0000000000000000}
m7masks[0,5] := $0000; {0000000000000000}
m7masks[0,6] := $0000; {0000000000000000}
m7masks[0,7] := $0000; {0000000000000000}
m7masks[0,8] := $0000; {0000000000000000}
m7masks[0,9] := $8001; {1000000000000001}
m7masks[0,10] := $C003; {1100000000000011}
m7masks[0,11] := $E007; {1110000000000111}
m7masks[0,12] := $F81F; {1111100000011111}
m7masks[0,13] := $FFFF; {1111111111111111}
m7masks[0,14] := $FFFF; {1111111111111111}
m7masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m7masks[1,0] := $0000; {0000000000000000}
m7masks[1,1] := $07E0; {0000011111100000}
m7masks[1,2] := $1FF8; {0001111111111000}
m7masks[1,3] := $3FFC; {0011111111111100}
m7masks[1,4] := $7E7E; {0111111001111110}
m7masks[1,5] := $7E7E; {0111111001111110}
m7masks[1,6] := $7E7E; {0111111001111110}
m7masks[1,7] := $7E7E; {0111111001111110}
m7masks[1,8] := $7DFE; {0111110111111110}
m7masks[1,9] := $3BFC; {0011101111111100}
m7masks[1,10] := $1BF8; {0001101111111000}
m7masks[1,11] := $07E0; {0000011111100000}
m7masks[1,12] := $0000; {0000000000000000}
m7masks[1,13] := $0000; {0000000000000000}
m7masks[1,14] := $0000; {0000000000000000}
m7masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m7masks);
regs.ES := seg(m7masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse8;
var
m8masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m8masks[0,0] := $F81F; {1111100000011111}
m8masks[0,1] := $E007; {1110000000000111}
m8masks[0,2] := $C003; {1100000000000011}
m8masks[0,3] := $8001; {1000000000000001}
m8masks[0,4] := $0000; {0000000000000000}
m8masks[0,5] := $0000; {0000000000000000}
m8masks[0,6] := $0000; {0000000000000000}
m8masks[0,7] := $0000; {0000000000000000}
m8masks[0,8] := $0000; {0000000000000000}
m8masks[0,9] := $8001; {1000000000000001}
m8masks[0,10] := $C003; {1100000000000011}
m8masks[0,11] := $E007; {1110000000000111}
m8masks[0,12] := $F81F; {1111100000011111}
m8masks[0,13] := $FFFF; {1111111111111111}
m8masks[0,14] := $FFFF; {1111111111111111}
m8masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m8masks[1,0] := $0000; {0000000000000000}
m8masks[1,1] := $07E0; {0000011111100000}
m8masks[1,2] := $1FF8; {0001111111111000}
m8masks[1,3] := $3FFC; {0011111111111100}
m8masks[1,4] := $7E7E; {0111111001111110}
m8masks[1,5] := $7E7E; {0111111001111110}
m8masks[1,6] := $7E7E; {0111111001111110}
m8masks[1,7] := $787E; {0111100001111110}
m8masks[1,8] := $67FE; {0110011111111110}
m8masks[1,9] := $1FFC; {0001111111111100}
m8masks[1,10] := $1FF8; {0001111111111000}
m8masks[1,11] := $07E0; {0000011111100000}
m8masks[1,12] := $0000; {0000000000000000}
m8masks[1,13] := $0000; {0000000000000000}
m8masks[1,14] := $0000; {0000000000000000}
m8masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m8masks);
regs.ES := seg(m8masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse9;
var
m9masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m9masks[0,0] := $F81F; {1111100000011111}
m9masks[0,1] := $E007; {1110000000000111}
m9masks[0,2] := $C003; {1100000000000011}
m9masks[0,3] := $8001; {1000000000000001}
m9masks[0,4] := $0000; {0000000000000000}
m9masks[0,5] := $0000; {0000000000000000}
m9masks[0,6] := $0000; {0000000000000000}
m9masks[0,7] := $0000; {0000000000000000}
m9masks[0,8] := $0000; {0000000000000000}
m9masks[0,9] := $8001; {1000000000000001}
m9masks[0,10] := $C003; {1100000000000011}
m9masks[0,11] := $E007; {1110000000000111}
m9masks[0,12] := $F81F; {1111100000011111}
m9masks[0,13] := $FFFF; {1111111111111111}
m9masks[0,14] := $FFFF; {1111111111111111}
m9masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m9masks[1,0] := $0000; {0000000000000000}
m9masks[1,1] := $07E0; {0000011111100000}
m9masks[1,2] := $1FF8; {0001111111111000}
m9masks[1,3] := $3FFC; {0011111111111100}
m9masks[1,4] := $7E7E; {0111111001111110}
m9masks[1,5] := $7E7E; {0111111001111110}
m9masks[1,6] := $007E; {0000000001111110}
m9masks[1,7] := $7E7E; {0111111001111110}
m9masks[1,8] := $7FFE; {0111111111111110}
m9masks[1,9] := $3FFC; {0011111111111100}
m9masks[1,10] := $1FF8; {0001111111111000}
m9masks[1,11] := $07E0; {0000011111100000}
m9masks[1,12] := $0000; {0000000000000000}
m9masks[1,13] := $0000; {0000000000000000}
m9masks[1,14] := $0000; {0000000000000000}
m9masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m9masks);
regs.ES := seg(m9masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse10;
var
m10masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m10masks[0,0] := $F81F; {1111100000011111}
m10masks[0,1] := $E007; {1110000000000111}
m10masks[0,2] := $C003; {1100000000000011}
m10masks[0,3] := $8001; {1000000000000001}
m10masks[0,4] := $0000; {0000000000000000}
m10masks[0,5] := $0000; {0000000000000000}
m10masks[0,6] := $0000; {0000000000000000}
m10masks[0,7] := $0000; {0000000000000000}
m10masks[0,8] := $0000; {0000000000000000}
m10masks[0,9] := $8001; {1000000000000001}
m10masks[0,10] := $C003; {1100000000000011}
m10masks[0,11] := $E007; {1110000000000111}
m10masks[0,12] := $F81F; {1111100000011111}
m10masks[0,13] := $FFFF; {1111111111111111}
m10masks[0,14] := $FFFF; {1111111111111111}
m10masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m10masks[1,0] := $0000; {0000000000000000}
m10masks[1,1] := $07E0; {0000011111100000}
m10masks[1,2] := $1FF8; {0001111111111000}
m10masks[1,3] := $1FFC; {0001111111111100}
m10masks[1,4] := $667E; {0110011001111110}
m10masks[1,5] := $7A7E; {0111101001111110}
m10masks[1,6] := $7C7E; {0111110001111110}
m10masks[1,7] := $7E7E; {0111111001111110}
m10masks[1,8] := $7FFE; {0111111111111110}
m10masks[1,9] := $3FFC; {0011111111111100}
m10masks[1,10] := $1FF8; {0001111111111000}
m10masks[1,11] := $07E0; {0000011111100000}
m10masks[1,12] := $0000; {0000000000000000}
m10masks[1,13] := $0000; {0000000000000000}
m10masks[1,14] := $0000; {0000000000000000}
m10masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m10masks);
regs.ES := seg(m10masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse11;
var
m11masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m11masks[0,0] := $F81F; {1111100000011111}
m11masks[0,1] := $E007; {1110000000000111}
m11masks[0,2] := $C003; {1100000000000011}
m11masks[0,3] := $8001; {1000000000000001}
m11masks[0,4] := $0000; {0000000000000000}
m11masks[0,5] := $0000; {0000000000000000}
m11masks[0,6] := $0000; {0000000000000000}
m11masks[0,7] := $0000; {0000000000000000}
m11masks[0,8] := $0000; {0000000000000000}
m11masks[0,9] := $8001; {1000000000000001}
m11masks[0,10] := $C003; {1100000000000011}
m11masks[0,11] := $E007; {1110000000000111}
m11masks[0,12] := $F81F; {1111100000011111}
m11masks[0,13] := $FFFF; {1111111111111111}
m11masks[0,14] := $FFFF; {1111111111111111}
m11masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m11masks[1,0] := $0000; {0000000000000000}
m11masks[1,1] := $07E0; {0000011111100000}
m11masks[1,2] := $1BF8; {0001101111111000}
m11masks[1,3] := $3BFC; {0011101111111100}
m11masks[1,4] := $7C7E; {0111110001111110}
m11masks[1,5] := $7C7E; {0111110001111110}
m11masks[1,6] := $7E7E; {0111111001111110}
m11masks[1,7] := $7E7E; {0111111001111110}
m11masks[1,8] := $7FFE; {0111111111111110}
m11masks[1,9] := $3FFC; {0011111111111100}
m11masks[1,10] := $1FF8; {0001111111111000}
m11masks[1,11] := $07E0; {0000011111100000}
m11masks[1,12] := $0000; {0000000000000000}
m11masks[1,13] := $0000; {0000000000000000}
m11masks[1,14] := $0000; {0000000000000000}
m11masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m11masks);
regs.ES := seg(m11masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
PROCEDURE Mouse12;
var
m12masks : array[0..1,0..15] of word;
Regs : Registers;
BEGIN
{ Screen Mask }
m12masks[0,0] := $F81F; {1111100000011111}
m12masks[0,1] := $E007; {1110000000000111}
m12masks[0,2] := $C003; {1100000000000011}
m12masks[0,3] := $8001; {1000000000000001}
m12masks[0,4] := $0000; {0000000000000000}
m12masks[0,5] := $0000; {0000000000000000}
m12masks[0,6] := $0000; {0000000000000000}
m12masks[0,7] := $0000; {0000000000000000}
m12masks[0,8] := $0000; {0000000000000000}
m12masks[0,9] := $8001; {1000000000000001}
m12masks[0,10] := $C003; {1100000000000011}
m12masks[0,11] := $E007; {1110000000000111}
m12masks[0,12] := $F81F; {1111100000011111}
m12masks[0,13] := $FFFF; {1111111111111111}
m12masks[0,14] := $FFFF; {1111111111111111}
m12masks[0,15] := $FFFF; {1111111111111111}
{ Cursor Mask }
m12masks[1,0] := $0000; {0000000000000000}
m12masks[1,1] := $0760; {0000011101100000}
m12masks[1,2] := $1F78; {0001111101111000}
m12masks[1,3] := $3F7C; {0011111101111100}
m12masks[1,4] := $7E7E; {0111111001111110}
m12masks[1,5] := $7E7E; {0111111001111110}
m12masks[1,6] := $7E7E; {0111111001111110}
m12masks[1,7] := $7E7E; {0111111001111110}
m12masks[1,8] := $7FFE; {0111111111111110}
m12masks[1,9] := $3FFC; {0011111111111100}
m12masks[1,10] := $1FF8; {0001111111111000}
m12masks[1,11] := $07E0; {0000011111100000}
m12masks[1,12] := $0000; {0000000000000000}
m12masks[1,13] := $0000; {0000000000000000}
m12masks[1,14] := $0000; {0000000000000000}
m12masks[1,15] := $0000; {0000000000000000}
regs.AX := 9;
regs.BX := 1;
regs.CX := 0;
regs.DX := ofs(m12masks);
regs.ES := seg(m12masks);
Intr(51,Regs);
end;
{--------------------------------------------------------------------------}
function EGAthere: boolean;
begin
detectgraph(sysgraphadapter, sysgraphmode);
if sysgraphadapter = 3 or 9 then EGAthere := true;
end;
{--------------------------------------------------------------------------}
{ These procedures link the EGAVGA.BGI driver into the EXE file. }
procedure egavgadriver; external;
{$L D:\TP\EGAVGA.OBJ} { This is the directory where I keep the
object version of the EGAVGA.BGI driver.}
procedure RegisterEGAVGA;
begin
if RegisterBGIDriver(@egavgadriver) < 0 then
begin
writeln('Error registering driver:',Grapherrormsg(graphresult));
readln;
Halt(1);
end;
end;
{--------------------------------------------------------------------------}
procedure initega;
{ Initializes EGA 640x350x16 graphics if an EGA or VGA card is detected. }
var
grapherror : integer;
begin
if EGAthere then
begin
graphdriver := 3;
graphmode := 1;
initgraph(graphdriver, Graphmode,'D:\TP');
Grapherror := graphresult;
if grapherror <> 0 then
begin
writeln('Error initializing graphics:',Grapherrormsg(grapherror));
halt(1);
end;
end;
end;
{--------------------------------------------------------------------------}
PROCEDURE CheckForMouse;
BEGIN
x1 := wherex;
y1 := wherey;
writeln(' Checking for mouse...');
delay(1000);
If not MouseIsInstalled then
begin
writeln(' This demo requires a mouse.');
writeln(' No mouse driver could be detected.');
halt(2);
end
else
begin
gotoxy(x1,y1);
clreol;
writeln(' A mouse is installed.');
delay(1000);
end;
writeln;
end;
{--------------------------------------------------------------------------}
PROCEDURE CheckForEGA;
BEGIN
x1 := wherex;
y1 := wherey;
writeln(' Checking for EGA...');
delay(1000); { the delay is just to give the user }
If not EGAthere then { time to read the screen }
begin
writeln(' This demo requires EGA 640x350x16 graphics.');
writeln(' EGA or capatible graphics could not be detected.');
halt(2);
end
else
begin
gotoxy(x1,y1);
clreol;
writeln(' EGA is installed.');
delay(1000);
end;
writeln;
end;
{--------------------------------------------------------------------------}
Procedure drawcb; { Draws the grapfic 'Continue' button. }
begin
setfillstyle(1,ltgray);
bar(282,327,358,338);
setcolor(white);
moveto(280,340);
lineto(280,325);
lineto(360,325);
setcolor(black);
moveto(360,326);
lineto(360,340);
lineto(282,340);
moveto(279,341);
lineto(279,324);
lineto(361,324);
setcolor(white);
moveto(361,325);
lineto(361,341);
lineto(280,341);
setcolor(black);
settextstyle(2,0,4);
settextjustify(1,1);
outtextxy(320,331,'Continue');
end;
{--------------------------------------------------------------------------}
Procedure presscb; { 'Lights' the graphic continue button when 'pressed'.}
begin
setfillstyle(1,white);
setcolor(black);
settextstyle(2,0,4);
settextjustify(1,1);
hidemouse;
bar(282,327,358,338);
outtextxy(320,331,'Continue');
showmouse;
delay(500);
setfillstyle(1,ltgray);
hidemouse;
bar(279,324,361,342);
showmouse;
end;
{--------------------------------------------------------------------------}
Procedure Beep;
begin
sound(mx);
delay(100);
sound(my);
delay(100);
nosound;
end;
{--------------------------------------------------------------------------}
Procedure FlushKey; { Clears any key strokes in the key- }
{ board buffer so a couple of key }
var { presses don't race you through program. }
Regs : Registers;
begin
Regs.AH := $01; { AH=1: Check for keystroke }
Intr($16,regs); { Interupt $16: Keyboard services}
IF (regs.Flags and $0040) = 0 then { if chars in buffer }
REPEAT
Regs.AH := 0;
Intr($16,Regs);
Regs.AH := $01;
Intr($16,Regs);
Until (regs.flags and $0040) <> 0;
end;
{--------------------------------------------------------------------------}
Procedure Wait; { Waits for keypress or mouse click. }
begin
continue := false;
flushkey;
Repeat
if keypressed then
begin
ch := readkey;
presscb;
continue := true;
end
else
pollmouse(mx,my,lb,rb,bb);
if lb then
begin
case my of
326..339 :
begin
case mx of
281..357 : begin
presscb;
continue := true;
end;
else beep; { Two tone beep based on mouse position. }
end; {case mx}
end;
else beep;
end; {case my}
end;
until continue;
settextjustify(0,1);
end;
{--------------------------------------------------------------------------}
Procedure TMContinue; { Text mode button flash. }
begin
window(1,1,80,24);
gotoxy(37,24);
textcolor(15);
hidemouse;
write('Continue');
textcolor(0);
showmouse;
delay(500);
hidemouse;
gotoxy(37,24);
write('Continue');
showmouse;
window(1,5,80,22);
showmouse;
continue := true;
end;
{--------------------------------------------------------------------------}
Procedure TMWait; { Text mode Wait. }
begin
continue := false;
flushkey;
repeat
if keypressed then
begin
ch := readkey;
TMContinue;
end
else
pollmouse(mx,my,lb,rb,bb);
if lb then
begin
case my of
184 :
begin
case mx of
280..360 : TMContinue;
else beep;
end; {case mx}
end;
else beep;
end; {case my}
end;
until continue;
end;
{--------------------------------------------------------------------------}
Procedure writeTextTitle;
begin
writeln(' ');
writeln(' ',title,' ');
writeln(' ');
end;
{--------------------------------------------------------------------------}
BEGIN
clrscr;
textbackground(7);
textcolor(0);
writetexttitle;
textbackground(0);
textcolor(7);
checkformouse;
gotoxy(1,4);
clreol;
checkforega;
gotoxy(1,4);
clreol;
clrscr;
textbackground(7);
textcolor(0);
clrscr;
writetexttitle;
exitsave := exitproc; { Saves current exit procedure. }
exitproc := @mcedemoexit; { Installs my exit procedure. }
registeregavga;
{ Screen 1 }
gotoxy(35,23);
write('╔══════════╗');
gotoxy(35,24);
write('║ Continue ║');
gotoxy(35,25);
write('╚══════════╝');
window(1,5,80,22);
writeln(' This demo will show you some of the things you can do with a mouse.');
writeln(' I apologize for the sloppy code, but it works.');
writeln;
writeln(' Brand and product names mentioned are trademarks or registered trademarks');
writeln(' of their respective holders.');
writeln;
writeln(' To continue, click on the continue button, or press any key.');
mousereset;
showmouse;
tmwait;
hidemouse;
clrscr;
{ Screen 2 }
gotoxy(1,1);
writeln(' MOUSE CURSOR EDITOR (MCEDIT) is designed to make it easier to write');
writeln(' programs that use a mouse. MCEDIT is a graphical mouse cursor editor. You');
writeln(' draw the cursor that you want and MCEDIT writes the code for the screen and');
writeln(' cursor masks required to display that mouse cursor. Version 1.0 can output');
writeln(' the code as a Pascal procedure, in hex, in binary, or hex and binary. If you');
writeln(' have ever created a mouse cursor by hand, yoy will appreciate this program.');
writeln(' MCEDIT was written with Turbo Pascal 5.0.');
writeln;
writeln(' The unit that included with MCEDIT contains procedures and functions');
writeln(' for using a mouse in Turbo Pascal. The unit (BOBMOUSE.TPU) was written and');
writeln(' compiled in TP 5.0, but I''m sure they could be adapted for newer versions.');
writeln(' The procedures and functions in the unit are based on ones from a variety of');
writeln(' sources, including Jeff Duntemann''s book "Complete Turbo Pascal, Third');
writeln(' Edition" published by Scott, Foresman and Company, and the "Microsoft Mouse');
writeln(' Programmer''s Referance", Microsoft Press. I highly recommend both books.');
showmouse;
tmwait;
clrscr;
{ Screen 3 }
gotoxy(1,1);
writeln(' Procedures and functions in the unit can provide the user and or the program');
writeln(' with some information about the mouse and mouse driver on the computer.');
writeln;
writeln(' Here is some information about the mouse and mouse driver on this system.');
writeln;
writeln(' Mouse driver version : ',getmouseversion);
writeln(' Mouse type : ',getmousetype);
writeln(' Mouse IRQ : ',getmouseIRQ);
writeln(' Number of buttons : ',getnumberofmousebuttons);
write(' Mouse cursor position: ');
mousereset;
showmouse;
x1 := wherex;
y1 := wherey;
flushkey;
continue := false;
repeat
if keypressed then
begin
ch := readkey;
TMContinue;
end
else
pollmouse(mx,my,lb,rb,bb);
hidemouse;
gotoxy(x1,y1);
clreol;
write('(',mx div 8 + 1,',',my div 8 + 1,')');
showmouse;
delay(100);
if lb then
begin
case my of
184 :
begin
case mx of
280..360 : TMContinue;
else beep;
end; {case mx}
end;
else beep;
end; {case my}
end;
until continue;
hidemouse;
clrscr;
gotoxy(30,10);
writeln('Time for graphics mode...');
showmouse;
delay(1000);
hidemouse;
{ GRAPHICS MODE }
Initega;
black := 1;
setpalette(1,0);
setpalette(14,63); { so the inverse to black is OK }
white := 2;
setpalette(2,63);
ltgray := 7;
dkgray := 8;
ltgreen := 10;
setfillstyle(1,ltgray);
bar(0,0,getmaxx,getmaxy);
settextjustify(0,2);
settextstyle(2,0,4);
setcolor(black);
outtextxy(11,3,title);
outtextxy(235,180,'... and some fun with the mouse.');
delay(1500);
bar(235,180,420,190);
settextjustify(0,1);
outtextxy(11,33,'As you have previously seen, your program can use a number of mouse function calls to get information');
outtextxy(11,43,'from the mousedriver about the mouse. Your program can also use mouse function calls to control the');
outtextxy(11,53,'mouse.');
drawcb;
mousereset;
showmouse;
wait;
hidemouse; { Each time you draw to the screen it is a good idea to }
{ hide the mouse, because of the why the mouse driver works }
{ with video memory. }
Outtextxy(11,73,'You can hide the mouse...');
showmouse;
delay(500);
pollmouse(mx,my,lb,rb,bb);
hidemouse;
outtextxy(mx-40,my-10,'Now you see it...');
showmouse;
delay(500);
hidemouse;
outtextxy(mx-40,my+10,'Now you don''t!');
delay(3000);
bar(mx-50,my-12,mx+60,my+20);
drawcb;
showmouse;
wait;
hidemouse;
Outtextxy(11,83,'You can move the mouse...');
showmouse;
for i := 1 to 10 do
begin
mx := random(319);
my := random(174);
MouseToXY(160+mx,86+my);
delay(500);
end;
MouseToXY(20,170);
for I := 21 to 620 do
begin
MouseToXY(I,170);
end;
hidemouse;
Outtextxy(11,93,'Moving the mouse should be used sparingly because it can mentally disrupt the user/pointer connection.');
drawcb;
showmouse;
wait;
hidemouse;
bar(11,90,639,102);
Outtextxy(11,93,'You can limit the area the mouse can move in...');
showmouse;
MouseToXY(400,200);
SetColumnRange(351,449);
SetRowRange(151,249);
for x := 350 to 450 do
begin
conditionaloff(x-16,134,x+16,166);
putpixel(x,150,ltGreen);
showmouse;
delay(2);
end;
for y := 150 to 250 do
begin
conditionaloff(434,y-16,466,y+16);
putpixel(450,y,ltGreen);
showmouse;
delay(2);
end;
for x := 450 downto 350 do
begin
conditionaloff(x-16,234,x+16,266);
putpixel(x,250,ltGreen);
showmouse;
delay(2);
end;
for y := 250 downto 150 do
begin
conditionaloff(334,y-16,366,y+16);
putpixel(350,y,ltGreen);
showmouse;
delay(2);
end;
OutTextXY(250,258,'The mouse will not be able to leave the rectangle.');
OutTextXY(300,268,'(press the right button to continue)');
continue := false;
repeat
pollmouse(mx,my,lb,rb,bb);
if rb then continue := true
until continue;
SetColumnRange(0,639);
SetRowRange(0,349);
hidemouse;
bar(250,150,639,277);
Outtextxy(11,103,'And, of coarse, you can change the shape of the mouse cursor. This is why I wrote MCEDIT.');
drawcb;
showmouse;
wait;
hidemouse;
Outtextxy(11,113,'Your mouse cursor could...');
Outtextxy(41,123,'become the ''evil anti-mouse'',');
drawcb;
blackmouse;
showmouse;
wait;
hidemouse;
Outtextxy(41,133,'let the user know they will have to wait,');
watchmouse;
drawcb;
showmouse;
wait;
hourglasmouse;
hidemouse;
drawcb;
showmouse;
wait;
hidemouse;
Outtextxy(41,143,'change to pointer to suit your style,');
handmouse;
drawcb;
showmouse;
wait;
hidemouse;
Outtextxy(41,153,'or to indicate the use of a certain accessory, like a hand scanner,');
handscanmouse;
drawcb;
showmouse;
wait;
hidemouse;
Outtextxy(41,163,'or to indicate an operation like resizing a window or object on the screen,');
horsizemouse;
drawcb;
showmouse;
wait;
hidemouse;
drawcb;
vertsizemouse;
showmouse;
drawcb;
wait;
hidemouse;
Outtextxy(41,173,'or the use of a tool,');
texttmouse;
drawcb;
showmouse;
wait;
hidemouse;
Outtextxy(41,183,'or zooming.');
magglassmouse;
drawcb;
showmouse;
wait;
hidemouse;
Outtextxy(11,193,'Your cursor can take on almost any shape.');
defaultmouse;
drawcb;
showmouse;
wait;
hidemouse;
Outtextxy(11,203,'You can also animate the cursor...');
showmouse;
d:=50;
for i := 1 to 10 do
begin
mouse1;
delay(d);
mouse2;
delay(d);
mouse3;
delay(d);
mouse4;
delay(d);
mouse5;
delay(d);
mouse6;
delay(d);
mouse7;
delay(d);
mouse8;
delay(d);
mouse9;
delay(d);
mouse10;
delay(d);
mouse11;
delay(d);
mouse12;
delay(d);
end;
hidemouse;
defaultmouse;
Outtextxy(11,213,'The pixels that make up your mouse cursor will be either...');
Outtextxy(41,223,'white,');
drawcb;
showmouse;
wait;
hidemouse;
blackmouse;
Outtextxy(41,233,'black,');
drawcb;
showmouse;
wait;
hidemouse;
seethrghmouse;
Outtextxy(41,243,'the under lying color,');
drawcb;
showmouse;
wait;
hidemouse;
inversemouse;
Outtextxy(41,253,'or inverse the under lying color.');
drawcb;
showmouse;
wait;
hidemouse;
defaultmouse;
Outtextxy(11,263,'And, with pallete manipulation, any color supported by the system.');
drawcb;
showmouse;
wait;
for i := 0 to 63 do
begin
setpalette(15,i);
delay(d);
end;
hidemouse;
drawcb;
showmouse;
wait;
hidemouse;
drawcb;
settextjustify(0,1);
Outtextxy(11,283,'I hope you find MCEDIT a useful tool.');
Outtextxy(11,293,'Good luck with your programing,');
bobsignp := @bobsign;
putimage(200,293,bobsignp^,normalput);
showmouse;
wait;
END.